﻿///
/// Diffable
/// 
/// Diffable is a module that makes it easy and natural to unit test and debug 
/// values belonging to discriminated union types. It does so by providing 
/// functions that generate DOT code representing such values as trees.
///
// Implementation Notes:
//
// It is intended that types used to instantiate the 'Diffable type argument 
// be discriminated unions. 
//
// In comments, when we refer to values of these types, 
// we need to make sure we're not being ambiguous about whether we're referring 
// to the entire tree rooted at that value or only the root. 
// To this end, we use the following terminology:
//
// We refer to the tree rooted at a 'Diffable value t as "the tree t".
//
// We refer to the root of the aforementioned tree simply as "t", or "the node t"
//
module Diffable

open Microsoft.FSharp.Reflection

let private fst (x, _, _) = x
let private snd (_, x, _) = x
let private thrd (_, _, x) = x

/// A DiffInfo<'Context, 'Diffable> value contains information which is used for
/// generating DOT code for and performing comparison against a node belonging 
/// to type 'Diffable.
type DiffInfo<'Diffable, 'Context> = {
    /// The label to give the node representing this value in our DOT graph. 
    nodeLabel : string
    
    /// A list of all 'Diffable nodes that are considered children of
    /// this one. These will typically be either fields of a union case or elements
    /// of a containter which is itself a field of a union case.
    ///
    /// With each child, we tuple the context we wish to pass to it, as
    /// well as a string label for the edge incoming from the current(parent)
    /// node.
    children : ('Diffable*'Context*string) list

    /// A list of all fields of this node which are significant for structural 
    /// equivalence. We allow the IDiffable<'Context> implementor to explicitly 
    /// signify these so that they can filter out insignificant fields (such as 
    /// debug fields), as well as child fields, which should instead be placed 
    /// in the children list. 
    compFields : System.Object list
}

/// A record containing functions that help compare and generate DOT graphs
/// for trees of 'Diffable type.
///
/// Each DiffBundle value is associated with a diffing function which maps 
/// 'Diffable nodes to DiffInfo values. This diffing function is stored
/// as an upvalue of the DiffBundle's functions.
///
/// DiffBundle values should only be obtained as return values of the
/// diffBundle function.
type DiffBundle<'Diffable, 'Context> = {
    /// Returns true if the first and third arguments are structurally
    /// equivalent.
    /// 
    /// In Diffable, two trees are considered strucutrally equivalent if
    /// their roots belong to the same union case, the corresponding 
    /// values of their compFields lists are equal (w.r.t. System.Object.Equals),
    /// and each of their corresponding children are structurally equivalent.
    structuralEquiv : 'Diffable -> 'Diffable -> bool

    /// Returns DOT code for a list of 'Diffable values. This code specifies
    /// a graph which includes a tree for each value, in order. The differences
    /// between of each pair of consecutive trees are highlighted red.
    treeListDOTCode : ('Diffable list) -> string

    /// Returns a DOT file displaying the given 'Diffable tree.
    treeDOTCode : 'Diffable -> string

    /// Returns DOT code for a graph displaying trees for each of the two arguments, 
    /// coloring any subtrees in which the two differ red.
    treeDiff : 'Diffable -> 'Diffable -> string
}

/// diffBundle returns a record containing various functions for generating 
/// DOT code and performing custom structural comparisons for 'Diffable trees.
/// 
/// arguments:
/// 
/// - diffInfoFunc : 'Diffable -> 'Context -> DiffInfo<'Context, 'Diffable> -
/// 
/// Given a 'Diffable node and a context, diffInfoFunc returns a record of 
/// information about how the node will displayed as a node in a DOT graph,
/// as well as information about how it should be compared to other nodes
/// belonging to the same union case. See the definition of the 
/// DiffInfo<'Context, 'Diffable> type for an exact description of this information.
/// 
/// - emptyContext : 'Context -
///
/// A value of type 'Context which indicates no context at all. If you don't 
/// need to track information about a node's parent and siblings, just use () 
/// for this value.
let diffBundle<'Context, 'Diffable> 
           (diffInfoFunc : 'Diffable -> 'Context -> DiffInfo<'Diffable, 'Context>) 
           (emptyContext : 'Context) =
    
    /// Returns true iff the nodes t0 and t1 are equivalent modulo variable
    /// naming and debug info.
    let rootEquiv (t0 : 'Diffable)
                  (ctx0 : 'Context)
                  (t1 : 'Diffable)
                  (ctx1 : 'Context) =
         
        if t0.GetType() <> t1.GetType() then 
            false
        else
            let ty = t0.GetType()
            
            let (case0, _) = Reflection.FSharpValue.GetUnionFields(t0, ty)
            let (case1, _) = Reflection.FSharpValue.GetUnionFields(t1, ty)

            let children0 = (diffInfoFunc t0 ctx0).children
            let children1 = (diffInfoFunc t1 ctx1).children

            let compFields0 = (diffInfoFunc t0 ctx0).compFields
            let compFields1 = (diffInfoFunc t1 ctx1).compFields

            if case0 <> case1 then
                false
            else if children0.Length <> children1.Length then
                false
            else if compFields0.Length <> compFields1.Length then
                false
            else
                List.forall2 (=) compFields0 compFields1

    /// Returns a string containing DOT code relevant to the node t.
    ///
    /// Arguments:
    /// - ctx : 'Context -
    /// The context to consider the node t in.
    ///
    /// - t : IDiffable<'Context> - 
    /// The node we are generating DOT code for.
    ///
    /// - name : string -
    /// The unique identifier to give to the node t.
    ///
    /// - color : string -
    /// The color to give node t.
    let rootDOTCode (ctx : 'Context) 
                    (t : 'Diffable) 
                    (name : string) 
                    (color : string) =

        let diffInfo = diffInfoFunc t ctx
        let edgeLabels = List.map thrd diffInfo.children

        let quote string =
            "\"" + string + "\""

        let rootDotCode = "\n" + (quote name) + " [label = \"" + diffInfo.nodeLabel + "\", style=filled, color=" + color + "]"
        
        let makeEdge (i : int) =
            let label = edgeLabels.[i]
            (quote name) + " -> " + quote (name + " " + i.ToString()) + " [label = " + quote label + "]\n"
   
        let edgeSeq = seq {
            for i in 0 .. edgeLabels.Length-1 ->
                makeEdge i
        }

        let edgeDotCode = String.concat "" edgeSeq

        rootDotCode + edgeDotCode
    
    /// Returns a string containing DOT code for the tree corresponding to 
    /// the argument t.
    ///
    /// Arguments:
    /// - ctx : 'Context - 
    /// The context to consider the tree t in.
    ///
    /// - t : 'IDiffable<'Context> - 
    /// The tree to return DOT code for.
    ///
    /// - name : string - 
    /// The unique identifier given to the root node of the tree t. Descendant node
    /// names are generated by concatenating onto this identifier. 
    ///
    /// - color : string - 
    /// The color to give the nodes of the tree t.
    let rec treeDOTCodeRec (ctx : 'Context) 
                           (t : 'Diffable) 
                           (name : string) 
                           (color : string) =
    
        let nodeDotCode = rootDOTCode ctx t name color

        let (_, fields) = 
            Reflection.FSharpValue.GetUnionFields(t, t.GetType()) 
        
        let diffInfo = diffInfoFunc t ctx
        
        let children = List.map fst (diffInfo.children)
        let contexts = List.map snd (diffInfo.children)

        let children = (diffInfoFunc t ctx).children

        let subtreeSeq = seq {
            for i in 0 .. children.Length-1 do
                yield treeDOTCodeRec (snd children.[i])
                                     (fst children.[i])
                                     (name + " " + i.ToString())
                                     color
        }

        let subtreeDotCode = String.concat "" subtreeSeq

        nodeDotCode + subtreeDotCode

    /// Returns a DOT file displaying the two trees t0 and t1 under contexts
    /// ctx0 and ctx1 respectively, coloring any subtrees in which the two trees 
    /// differ red.
    ///
    /// The roots of the two trees are given the respective DOT node identifiers
    /// ("0s"+name) and ("1s"+name).
    let rec treeDiffRec (ctx0 : 'Context) 
                        (t0 : 'Diffable) 
                        (ctx1 : 'Context) 
                        (t1 : 'Diffable) 
                        (name : string) =
                     
        if rootEquiv t0 ctx0 t1 ctx1 then
            let n0DotCode = rootDOTCode ctx0 t0 ("0s"+name) "gray"
            let n1DotCode = rootDOTCode ctx1 t1 ("1s"+name) "gray"

            let subtreeSeq = seq {
                let children0 = List.map fst (diffInfoFunc t0 ctx0).children
                let children1 = List.map fst (diffInfoFunc t1 ctx1).children

                let childContexts0 = List.map snd (diffInfoFunc t0 ctx0).children
                let childContexts1 = List.map snd (diffInfoFunc t1 ctx1).children

                for i in 0 .. children0.Length-1 do
                    yield treeDiffRec childContexts0.[i]
                                      children0.[i]
                                      childContexts1.[i]
                                      children1.[i]
                                      (name + " " + i.ToString())
            }

            let subtreeDotCode = String.concat "" subtreeSeq

            n0DotCode + n1DotCode + subtreeDotCode
        else
            let treeCode0 = (treeDOTCodeRec ctx0 t0 ("0s"+name) "red")
            let treeCode1 = (treeDOTCodeRec ctx1 t1 ("1s"+name) "red")
            treeCode0 + treeCode1

    /// Returns DOT code displaying the tree for t1 under context ctx1,
    /// coloring any subtrees in which t0 and t1 differ red.
    ///
    /// The roots of the two trees are given the respective DOT node identifiers
    /// ("0s"+name) and ("1s"+name).
    let rec asymmTreeDiffRec (ctx0 : 'Context) 
                             (t0 : 'Diffable) 
                             (ctx1 : 'Context) 
                             (t1 : 'Diffable) 
                             (name : string) =
                     
        if rootEquiv t0 ctx0 t1 ctx1 then
            let n1DotCode = rootDOTCode ctx1 t1 ("1s"+name) "gray"

            let subtreeSeq = seq {
                let children0 = List.map fst (diffInfoFunc t0 ctx0).children
                let children1 = List.map fst (diffInfoFunc t1 ctx1).children

                let childContexts0 = List.map snd (diffInfoFunc t0 ctx0).children
                let childContexts1 = List.map snd (diffInfoFunc t1 ctx1).children

                for i in 0 .. children0.Length-1 do
                    yield asymmTreeDiffRec childContexts0.[i]
                                           children0.[i]
                                           childContexts1.[i]
                                           children1.[i]
                                           (name + " " + i.ToString())
            }

            let subtreeDotCode = String.concat "" subtreeSeq

            n1DotCode + subtreeDotCode
        else
            (treeDOTCodeRec ctx1 t1 ("1s" + name) "red")

    /// Returns true if t0 and t1 are structurally equivalent.
    ///    
    /// In Diffable, two trees are considered strucutrally equivalent if
    /// their roots belong to the same union case, the corresponding 
    /// values of their compFields lists are equal (w.r.t. System.Object.Equals),
    /// and each of their corresponding children are structurally equivalent.
    let rec structuralEquivRec  (t0 : 'Diffable)
                                (ctx0 : 'Context)
                                (t1 : 'Diffable)
                                (ctx1 : 'Context) =

                if not (rootEquiv t0 ctx0 t1 ctx1) then
                    false
                else

                    let children0 = (diffInfoFunc t0 ctx0).children
                    let children1 = (diffInfoFunc t1 ctx1).children

                    let isEquiv (f0, c0, _) (f1, c1, _) =
                        structuralEquivRec f0 c0 f1 c1

                    Seq.forall2 isEquiv children0 children1
    

    let structuralEquiv (t0 : 'Diffable) (t1 : 'Diffable) =
        structuralEquivRec t0 emptyContext t1 emptyContext

    let treeListDOTCode (treeList : 'Diffable list) =
        let trees = [
            for i in 0 .. treeList.Length-1 ->
                if i = 0 then 
                    (treeDOTCodeRec emptyContext treeList.[i] (i.ToString()+" ") "gray")
                else
                    (asymmTreeDiffRec emptyContext treeList.[i-1] emptyContext treeList.[i] (i.ToString()+" "))
        ]

        let forrestCode = String.concat "" trees

        "digraph { " + forrestCode + "\n}"
                
    let treeDOTCode  (t0 : 'Diffable) =
        "digraph {" + (treeDOTCodeRec emptyContext t0 "0" "gray") + "\n}"
    
    let treeDiff (t0 : 'Diffable) (t1 : 'Diffable) =
        let body = treeDiffRec emptyContext t0 emptyContext t1 ""  
        "digraph {" + body + "\n}"

    {
        structuralEquiv = structuralEquiv
        treeDOTCode = treeDOTCode
        treeListDOTCode = treeListDOTCode
        treeDiff = treeDiff
    }